package clnet;

use warnings;
use Sys::Hostname;
use Config;
use Net::Ping;
use ipinterfaces;
use cldb;
use clstatdb;
use Data::Dumper;

BEGIN {
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);

	$VERSION=0.1;
	@ISA	= qw(Exporter);
	@EXPORT_OK = qw(
		&CLNET2_get_network_list
		&CLNET2_assign_network_ips
		&CLNET2_unassign_network_ips
		&CLNET2_checklink
		&CLNET2_physical_link_checking
		&CLNET2_migrate_ips
		&CLNET2_gen_ip_list
		&CLNET2_validate_ips
	);
	@EXPORT = ();
	$exit_handler=undef;
}
our @EXPORT_OK;

eval { require "miitoollib.pm"; } ;

my $have_miiquery=0;
my $have_ethtoolquery=0;
my $have_ethtool=0;
my $have_ifconfig_status=0;	# for bsd
my $have_ethtool_bin=undef;
my $have_dladm=0;		# dladm is the Solaris datalink checker
my $have_dladm_bin=undef;	# ' ' '
my $have_entstat=0;		# entstat is the AIX datalink checker tool
my $have_entstat_bin=undef;	# entstat is the AIX datalink checker tool
my $have_linkloop=0;		# linkloop can be used on our hw address to
my $have_linkloop_bin=undef;	# applicable to HP-UX only

my $have_sendarp=0;
if(defined(&miitoollib::miiquery)) {
	$have_miiquery=1;
}
if(defined(&miitoollib::ethtoolquery)) {
	$have_ethtoolquery=1;
}
if(defined(&miitoollib::send_arp)) {
	$have_sendarp=1;
}

sub ifconfig_status($) {
my $card=shift;
my ($fd,@F,$cline);

	if(!open($fd,"/sbin/ifconfig $card|")) {
		::warning("Unable to run ifconfig");
		return(-1);
	}
	while(<$fd>) {
		if(/status:\s+(.*)/) {
			close($fd);
			if($1 eq "active") {
				return 1;
			} else {
				return 0;
			}
		}
	}
	close($fd);
	::warning("No status information returned for $card!");
	return(-1);
}

for my $cdir ("/sbin","/usr/sbin","/usr/bin","/bin") {
	if(-x "$cdir/ethtool") {
		$have_ethtool=1;
		$have_ethtool_bin="$cdir/ethtool";
		last;
	}
}

if($^O eq "freebsd") {
	$have_ifconfig_status=1;
	if(defined(&::msg)) {
		::msg("freebsd using ifconfig for link status.");
	}
}

if($^O eq "solaris") {
	for my $cdir ("/sbin","/usr/sbin","/usr/bin","/bin") {
		if(-x "$cdir/dladm") {
			$have_dladm=1;
			$have_dladm_bin="$cdir/dladm";
			last;
		}
	}
	if($have_dladm) {
		if(defined(&::msg)) {
			::msg("dladm found as '$have_dladm_bin'.");
		}
	}
}

if($^O eq "aix") {
	for my $cdir ("/sbin","/usr/sbin","/usr/bin","/bin") {
		if(-x "$cdir/entstat") {
			$have_entstat=1;
			$have_entstat_bin="$cdir/entstat";
			last;
		}
	}
	if($have_entstat) {
		if(defined(&::msg)) {
			::msg("entstat found as '$have_entstat_bin'.");
		}
	}
}

if($^O eq "hpux") {
	for my $cdir ("/sbin","/usr/sbin","/usr/bin","/bin") {
		if(-x "$cdir/linkloop") {
			$have_linkloop=1;
			$have_linkloop_bin="$cdir/linkloop";
			last;
		}
	}
	if($have_linkloop) {
		if(defined(&::msg)) {
			::msg("linkloop found as '$have_linkloop_bin'.");
		}
	}
}

#########################################################################
# CLNET2_get_network_list();						#
# Returns a list of network names that have been defined in the		#
# cluster definition for the current node.				#
# Results is (0,error_string) or (1,hashref)				#
# Hash is keyed on network name, value is reference of list of 		#
# physical cards.							#
#########################################################################

sub CLNET2_get_network_list {
my $db;

	$db=new cldb("$::ENV{TRUECL_CFG}/config.db");
	if(!defined($db)) {
		return(0,"Unable to open to 'config' database.");
	}
	my $res=$db->get_rows("SELECT * FROM TOPOLOGY;");
	$db->disconnect; $db=undef;
	if(!defined($res->[0]->{name})) {
		return(1,{});
	}
	my %R=();
	for (@$res) {
		$R{$_->{name}}=[split(/,/,$_->{lcards})];
	}
	return(1,{%R});
}

#########################################################################
# assign_ips(xml="x",appxml=>"y",network="z")				#
# Will assign all IP addresses (ignoring if already assigned) for the	#
# specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
# Note: It is the responsibility of the call to get a lock on the	#
# 	NET resource before making use of this routine.			#
#	The code here is based on the similar code found in the		#
#	ipinterfaces module (that code will be removed).		#
#									#
# 1.1.x series changes							#
# An optional rebuild=>1 can be sent if a IP addressing rebuild for	#
# the network in question is considered. Normally the IP addresses	#
# associated with the application are simply set based on the config	#
# with any existing /etc/cluster/.resoures/ips/app-net-IP files being	#
# deleted first.							#
#									#
# When rebuild=>1 is set then the files are left in place, and a first	#
# run through checks files against IP's for the application. If any	#
# files are found for no IP's then the IP in question is dropped.	#
#									#
# At that point the offending file is removed and then the process of	#
# adding IP's as normal is performed.					#
#########################################################################

sub _bits_to_mask($) {
my $b=$_[0];

	if($b =~ /\./) { return $b};

	my $mask=0xFFFFFFFF - ((1<<32-$b)-1);
	my @v=();
	for(0..3) {
		unshift @v,$mask&0xff;
		$mask=$mask>>8;
	}
	return join(".",@v);
}

sub CLNET2_validate_ips($) {
my $ip=$_[0];

	if($ip =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/ ||
		$ip =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+(\-\d+){0,1}(,[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+(\-\d+){0,1}){0,}$/ ||
		$ip =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+(,[0-9]+(\-\d+){0,1}){0,}/) {
		return 1;
	}
	return(0);
}

sub CLNET2_gen_ip_list($) {
my $ips=$_[0];
my %netmasks=();

	#########################################################
	# Cater for the special occurrence of when a network 	#
	# consists of MONITOR...				#
	#########################################################
	if(uc($ips) eq "MONITOR") {
		return ("",{});
	}

	my $first="";
	my @x=split(/,/,$ips);
	$ips="";
	for(@x) {
		my $m=undef;
		if(/\/(.*)/) {
			$m=_bits_to_mask($1);
			s/\/.*//;
		}
		my ($a,$b,$c,$d,@j)=split(/\./,$_);
		if(defined($a) && defined($b) && defined($c)) {
			$first="$a.$b.$c";
		}
		if(/(\d+)\-(\d+)$/) {
			my ($l1,$l2)=($1,$2);
			while($l1<=$l2) {
				$netmasks{"$first.$l1"}=$m if defined($m);
				$ips.=",$first.$l1";
				$l1++;
			}	
		} elsif(/^(\d+\.){1,}/) {
			$netmasks{$_}=$m if defined($m);
			$ips.=",$_";
		} else {
			$netmasks{"$first.$_"}=$m if defined($m);
			$ips.=",$first.$_";
		}
	}
	$ips=~s/^,//;
	return ($ips,{%netmasks});
}

#########################################################################
# Assign IP addresses for the given network topology on the current	#
# machine. It expects the following arguments, those in brackets	#
# can be unassigned or missing.						#
# appname	- Application name					#
# network	- The network details to update				#
# [results]	- refernce to array to push results to.			#
# [rebuild]	- If set to 1 then the application is already running,	#
# 	  	  and so the app_ips table should be referred to	#
# 	  	  first to see what has changed ... removing elements	#
# 	  	  if necessary.						#
# Will return:								#
# (0,errmsg)	- Error has occured.					#
# (1)		- IP Configuration applied successfully.		#
#########################################################################

sub CLNET2_assign_network_ips {
my %args=@_;
my $ifconfig;

	local $SIG{CHLD}='DEFAULT';
	$ifconfig="LD_PRELOAD= ifconfig";
	$ifconfig="LD_PRELOAD= /usr/sbin/ifconfig" if -x "/usr/sbin/ifconfig";
	$ifconfig="LD_PRELOAD= /sbin/ifconfig" if -x "/sbin/ifconfig";
	if(!exists($args{network}) || !exists($args{appname})) {
		return(0,"Missing one or more mandatory arguments (network,appname).");
	}
	my $results=[];
	my $iptype;
	my $ips;
	my $netmasks;
	my $network=$args{network};
	my $appname=$args{appname};
	$results=$args{results} if exists($args{results});
	my $rebuild=0;
	$rebuild=$args{rebuild} if (exists($args{rebuild}) && defined($args{rebuild}));
	if(!defined($network) || !length($network)) {
		return(0,"No network ID specified.");
	}

	#################################################################
	# Grab the necessary details of the network from the 		#
	# configuration database - aborting on error.			#
	#################################################################
	my $cldb=new cldb("$::ENV{TRUECL_CFG}/config.db");
	if(!defined($cldb)) {
		return(0,"Unable to open config database.");
	}
	my $res=$cldb->get_rows("SELECT * FROM APPLICATION_IPS WHERE name = '$appname' AND network = '$network';");
	$cldb->disconnect; $cldb=undef;
	if(!defined($res->[0]->{name})) {
		return(1);
	}
	$ips=$res->[0]->{ips};
	if(!defined($ips) || !length($ips)) {
		return(1);
	}

	$iptype=$res->[0]->{version};
	$iptype=4 if !defined($iptype);
	my $broadcast=$res->[0]->{broadcast} if (defined($res->[0]->{broadcast}) && length($res->[0]->{broadcast}));
	my $netmask=$res->[0]->{netmask} if (defined($res->[0]->{netmask}) && length($res->[0]->{netmask}));

	#################################################################
	# Convert the value to a real list of IP addresses.		#
	#################################################################
	if($ips =~ /^\d+\.\d+\.\d+\./) {
		($ips,$netmasks)=CLNET2_gen_ip_list($ips);
	}

	#################################################################
	# If we are rebuilding check the app_ips table in the status	#
	# database to get a list of currently configured IP.		#
	#################################################################

	my $clstat=new clstatdb("$::ENV{TRUECL_CFG}/status.db");
	if(!defined($clstat)) {
		return(0,"Unable to open status database.");
	}
	my $r=$clstat->create_if_needed("app_ips");
	if($r==0) {
		return(0,"Unable to create 'app_ips' table.");
	}
	my %configured=();
	if($rebuild) {
		my $ref=$clstat->get_rows("SELECT * FROM app_ips WHERE appname = '$appname' AND network = '$network';");
		if(defined($ref) && defined($ref->[0]->{appname})) {
			for (@$ref) {
				$configured{$_->{ind}}=[$_->{ip},$_->{type},$_->{netmask},$_->{broadcast}];
			}
		}
	}
	$clstat->disconnect; $clstat=undef;

	my $ipinters=new ipinterfaces();
	#################################################################
	# If performing a rebuild configured{} will contain details	#
	# of all IP addresses that are currently live. We now need to	#
	# compare this list to 'ips' which is a list taken from the	#
	# configurated database. Any that are not in ips are 		#
	# candiates to remove.						#
	#################################################################
	my @keep=();	# IP's configured in network
	if($rebuild && %configured) {
		my ($cip,$f);
		my @DELETE=();
		::msg(Dumper(%configured)) if defined(&::msg);
		for (keys(%configured)) {
			$f=0;
			$cip=$configured{$_}->[0];
			next if !defined($cip);
			for (split(/,/,$ips)) {
				if($_ eq $cip) {
					$f=1;last;
				}
			}
			if(!$f) {
				::msg("IP address $cip not found in $ips - so remove.") if defined(&::msg);
				push @DELETE,$cip;
			} else {
				::msg("IP address $cip found in $ips - so add/keep.") if defined(&::msg);
			}
		}
		#################################################
		# @D is the list of IP's to remove, so remove	#
		# the file and the IP address in question.	#
		#################################################
		for (@DELETE) {
			my $cip=$_;
			next if !defined($cip);
			#########################################
			# Get the interface details and remove	#
			# it.					#
			#########################################

			my $cint=$ipinters->get_interface(ip=>$cip);
			if(!defined($cint)) {
				::msg("Interface for IP address '$cip' not found - can not remove it!") if defined(&::msg);
				next;
			} 
			if($^O eq "solaris") {
				$cmd="$ifconfig $cint unplumb";
			} elsif($^O eq "freebsd") {
				my ($card,$inst)=split(/:/,$cint);
				if($inst==0) {
					$cmd="$ifconfig $card delete $cip ";
				} else {
					$cmd="$ifconfig $card -alias $cip ";
				}
			} else {
				$cmd="$ifconfig $cint inet 0.0.0.0 ";
			}
			::msg("Removing $cip: $cmd") if defined(&::msg);exit;
			$cmd.=" 2>&1";
			my $r=`$cmd`; chomp $r;
			if($?>>8 && length($r)) {
				next if $r =~ /Cannot assign requested/; # dodgy non-error
				push @$results,"WARN Unable to unassign IP address $cip from $cint";
				push @$results,"WARN Message from ifconfig: $r" if length($r);
			} else {
				push @$results,"LOG Unassigned IP address $cip from $cint";
			}
		}

		#########################################################
		# The IP address that have been deleted are now 	#
		# removed from app_ips status database.			#
		#########################################################
		if(@DELETE) {
			my $clstat=new clstatdb("$::ENV{TRUECL_CFG}/status.db");
			if(defined($clstat)) {
				my $r=$clstat->create_if_needed("app_ips");
				if($r==1) {
					for (@DELETE) {
						next if !defined($_);
						if(!$clstat->do("DELETE FROM app_ips WHERE appname = '$appname' AND network = '$network' AND ip = '$_';")) {
							::msg("Unable to remove $_ from status table app_ips.") if defined(&::msg);
						} else {
							::msg("Removed $_ from status table app_ips.") if defined(&::msg);
						}
					}
				}
				$clstat->disconnect;
			}
		}
	}
	my $use_miitoollib=defined(&miitoollib::send_arp);
 
	#################################################################
	# Now check the net exists in the list of networks in the	#
	# cluster topology.						#
	#################################################################

	my ($rc,$nets)=CLNET2_get_network_list();
	if(!$rc) {
		return(0,"Unable to get network list from cluster topology!");
	}

	if(!exists($nets->{$network})) {
		return(0,"Network $network not defined in cluster topology!");
	}

	#################################################################
	# Firstly we need to know which interface card we need to 	#
	# assign the addresses to...					#
	#################################################################
	my $card=undef;
	my $c;
	my @inuse=$ipinters->list(physical=>1);
	my @innet=(@{$nets->{$network}});
	for $c (@innet) {
		if(scalar(grep {$_ eq $c} @inuse)) {
			#################################################
			# Since some aggregations can have multiple	#
			# live cards we check for one that does 	#
			# currently have an in address associated.	#
			#################################################
			my $inf=$ipinters->get_details(interface => $c);
			if(defined($inf->{ip}) && length($inf->{ip})>0 &&
				$inf->{ip} ne "0.0.0.0") {
				$card=$c; last;
			}
		}
	}
	return(0,"Unable to find live card in network '$network'") if !defined($card);

	#################################################################
	# Before we assign any IP addresses clear out details for	#
	# this application/network from the app_ips if necessary.	#
	#################################################################
	if(!$rebuild) {
		my $clstat=new clstatdb("$::ENV{TRUECL_CFG}/status.db");
		if(defined($clstat)) {
			my $r=$clstat->create_if_needed("app_ips");
			if($r==1) {
				$clstat->do("DELETE FROM app_ips WHERE appname = '$appname' AND network = '$network';");
			}
			$clstat->disconnect;
		}
	}

	@ADD=();
	for $cip (split(/,/,$ips)) {
		next if ! length($cip);
		my $cmd;
		my $cint=$ipinters->get_interface(ip=>$cip);
		#########################################################
		# If the IP address is already assigned then just	#
		# check the broadcast and netmask and alter if 		#
		# necessary.						#
		#########################################################
		if(defined($cint)) {
			if($^O eq "freebsd") {
				my ($card,$inst)=split(/:/,$cint);
				if(!defined($inst) || $inst==0) {
					$cint="$card $cip";
				} else {
					$cint="$card alias $cip";
				}
			}
			$cmd="";
			if(exists($netmasks->{$cip})) {
				$cmd="$ifconfig $cint netmask ".$netm->{$cip};
			} elsif(defined($netmask)) {
				$cmd="$ifconfig $cint netmask $netmask";
			}
			$cmd.=" broadcast $broadcast " if defined($broadcast);
			if($cmd ne "") {
				push @$results,"LOG Configuring $cip: $cmd";
				::msg("Configuring $cip: $cmd") if defined(&::msg);
				$cmd.=" 2>&1";
				$r=`$cmd`; chomp $r;
				if($?>>8) {
					push @$results,"WARN Unable to change netmask on IP address $cip!";
				}
			}
			next;
		}

		#########################################################
		# Only get here if the specified IP address is not	#
		# assigned.						#
		# Now get a new interface number to assign to...	#
		#########################################################
		$cint=$ipinters->get_logical(always=>1,interface => $card);
		if($cint<0) {
			push @$results,"ERROR Unable to find interface '$card'.";
			return(0,"Unable to find interface '$card'.");
		}
		my $c_entry=[$cip];
		if($^O eq "freebsd") {
			if($cint==0) {
				$cmd="$ifconfig $card $cip ";
			} else {
				$cmd="$ifconfig $card alias $cip ";
			}
		} else {
			$cmd="$ifconfig $card:$cint inet $cip ";
		}
		if(exists($netmasks->{$cip})) {
			$cmd.=" netmask ".$netmasks->{$cip};
			push @$c_entry,$netmasks->{$cip};
		} else {
			if(defined($netmask)) {
				$cmd.=" netmask $netmask";
				push @$c_entry,$netmask;
			} else {
				push @$c_entry,"";
			}
		}
		if(defined($broadcast)) {
			$cmd.=" broadcast $broadcast";
			push @$c_entry,$broadcast;
		} else {
			push @$c_entry,"";
		}
		$cmd.=" up";

		#########################################################
		# If we are running on Solaris we need to plumb the	#
		# interface first.					#
		#########################################################
		if($^O eq "solaris") {
			my $cmd="$ifconfig $card:$cint plumb";
			$cmd.=" 2>&1";
			$r=`$cmd`; chomp $r;
			if($?>>8) {
				return(0,"Unable to plumb interface $card:$cint");
			}
		}
		push @$results,"LOG Configuring $cip: $cmd";
		::msg("Configuring $cip: $cmd") if defined(&::msg);
		$cmd.=" 2>&1";
		$r=`$cmd`; chomp $r;
		if($?>>8) {
			return(0,"Unable to assign IP address $cip to $card:$cint");
		}
		push @ADD,$c_entry;

		#########################################################
		# Now send out grat arp request for new IP address.	#
		#########################################################
		if($use_miitoollib) {
			push @$results,"LOG Sending Builtin Gratuitous arp for $card:$cint";
			$rc=miitoollib::send_arp("$card:$cint");
			if($rc ne "") {
				push @$results,"WARN Gratuitous arp request failed (error below)";
				push @$results,"WARN $rc";
			}
		} elsif(-x "$::ENV{TRUECL_CODE}/tools/send_arp") {
			$cmd="$::ENV{TRUECL_CODE}/tools/send_arp $card:$instance";
			push @$results,"LOG Sending Gratuitous arp: $cmd";
			$r=`$cmd 2>&1`;
			if(defined($::APPLICATION_RC)) {
				$rc=$::APPLICATION_RC;
			} else {
				$rc=$?>>8;
			}
			if($rc) {
				chomp $r;
				push @$results,"WARN Gratuitous arp request failed (error below).";
				push @$results,"WARN $r";
			}
		}
	}

	#################################################################
	# Before we exit we must wrte in the @ADD details into the	#
	# app_ips table for the appname/network.... We firstly need to	#
	# get a unique instance number...				#
	#################################################################
	if(@ADD) {
		my $clstat=new clstatdb("$::ENV{TRUECL_CFG}/status.db");
		if(!defined($clstat)) {
			return(0,"Unable to write to status database.");
		}
		my $ref=$clstat->get_rows("SELECT MAX(ind) AS ind FROM app_ips WHERE appname = '$appname' AND network = '$network';");
		my $ind=0;
		if(exists($ref->[0]->{ind}) && defined($ref->[0]->{ind})) {
			$ind=$ref->[0]->{ind}+1;
		}
		my $ctime=time;
		for (@ADD) {
			my $c=$_;
			my $ip=$c->[0];
			my $netmask=$c->[1];
			my $broadcast=$c->[2];
			if($clstat->do("INSERT OR REPLACE INTO app_ips (appname,network,ind,ip,type,netmask,broadcast,updatetime) VALUES ('$appname','$network','$ind','$ip','$iptype','$netmask','$broadcast','$ctime');")) {
				::msg("Added IP address $ip [index $ind] for network '$network'.") if defined(&::msg);
				$ind++;
			} else {
				::msg("Failed to add IP address $ip [index $ind] for network '$network'.") if defined(&::msg);
			}
		}
		$clstat->disconnect;
	}
	return(1);
}

#########################################################################
# unassign_ips(appname=>"name",network=>"xxx")				#
# appname	- Application name					#
# network	- The network details to update				#
# [results]	- refernce to array to push results to.			#
# Will unassign all IP addresses (ignoring if already unassigned) for 	#
# the specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
#									#
#########################################################################

sub CLNET2_unassign_network_ips {
my %args=@_;
my $ifconfig;

	local $SIG{CHLD}='DEFAULT';
	$ifconfig="LD_PRELOAD= ifconfig";
	$ifconfig="LD_PRELOAD= /usr/sbin/ifconfig" if -x "/usr/sbin/ifconfig";
	$ifconfig="LD_PRELOAD= /sbin/ifconfig" if -x "/sbin/ifconfig";
	if(!exists($args{network}) || !exists($args{appname})) {
		return(0,"Missing one or more mandatory arguments (network,appname).");
	}
	my $network=$args{network};
	my $appname=$args{appname};
	my $results=$args{results} if exists($args{results});
	$results=[] if !defined($results);

	#################################################################
	# Remove any app_ips for this network/application.		#
	#################################################################
	my $stat_rows=undef;
	{
		my $clstat=new clstatdb("$::ENV{TRUECL_CFG}/status.db");
		if(defined($clstat)) {
			my $r=$clstat->create_if_needed("app_ips");
			$stat_rows=$clstat->get_rows("SELECT * FROM app_ips WHERE appname = '$appname' AND network = '$network';");
			$clstat->do("DELETE FROM app_ips WHERE appname = '$appname' AND network = '$network';");
			$clstat->disconnect;
		}
	}

	#################################################################
	# Get details from the list of defined - even if not all	#
	# defined.							#
	#################################################################

	my $cldb=new cldb("$::ENV{TRUECL_CFG}/config.db");
	if(!defined($cldb)) {
		return(0,"Unable to open config database.");
	}
	my $res=$cldb->get_rows("SELECT * FROM APPLICATION_IPS WHERE name = '$appname' AND network = '$network';");
	$cldb->disconnect; $cldb=undef;
	if(!defined($res->[0]->{name})) {
		return(1);
	}
	my $ips=$res->[0]->{ips};
	if(!defined($ips) || !length($ips)) {
		return(1);
	}

	#################################################################
	# Convert the value to a real list of IP addresses.		#
	#################################################################
	if($ips =~ /^\d+\.\d+\.\d+\./) {
		($iplist,$netm)=CLNET2_gen_ip_list($ips);
	} else {
		$iplist=$ips;
	}
	
	#################################################################
	# Attempt to find any of the IP addresses and remove them	#
	# using ifconfig.						#
	#################################################################

	my $ipinters=new ipinterfaces();
	#################################################################
	# ips might include multiple IP addresses, so if so we		#
	# deal with that now...						#
	# Also rather than just N,N also handle N-N for ranges.		#
	#################################################################
	my $cip;
	for $cip (split(/,/,$iplist)) {
		next if ! length($cip);
		if($cip !~ /^\d+\.\d+\.\d+\.\d+$/) {
			my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname("$cip");
			if(@addrs) {
				$cip=sprintf("%d.%d.%d.%d",unpack("C4",$addrs[0]));
			}
		}
		my $cmd;
		my $cint=$ipinters->get_interface(ip=>$cip);
		if(!defined($cint)) {
			::warning("Unable to find interface for IP '$cip'.") if defined(&::warning);
			next;
		}

		if($^O eq "solaris") {
			$cmd="$ifconfig $cint unplumb";
		} else {
			if($^O eq "freebsd") {
				my ($card,$inst)=split(/:/,$cint);
				if($inst==0) {
					$cmd="$ifconfig $card delete $cip ";
				} else {
					$cmd="$ifconfig $card -alias $cip ";
				}
			} else {
				$cmd="$ifconfig $cint inet 0.0.0.0 ";
			}
		}
		push @$results,"LOG Removing $cip: $cmd";
		$cmd.=" 2>&1";
		my $r=`$cmd`; chomp $r;
		::msg("Removing $cip: $cmd") if defined(&::msg);
		if($?>>8 && length($r)) {
			next if $r =~ /Cannot assign requested/; # dodgy non-error
			return(0,"Unable to unassign IP address $cip from $cint - '$r'");
		}
	}

	#################################################################
	# See if we have any in the stats table that we have not yet	#
	# removed and remove them now.					#
	#################################################################
	if(defined($stat_rows) && defined($stat_rows->[0]->{ip})) {
		my ($cip,$cmd);
		my @D=split(/,/,$iplist);
		for my $crow (@$stat_rows) {
			if(! grep {$crow->{ip} eq $_} @D) {
				$cip=$crow->{ip};
				if($cip !~ /^\d+\.\d+\.\d+\.\d+$/) {
					my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname("$cip");
					if(@addrs) {
						$cip=sprintf("%d.%d.%d.%d",unpack("C4",$addrs[0]));
					}
				}
				my $cint=$ipinters->get_interface(ip=>$cip);
				next if !defined($cint);
				if($^O eq "solaris") {
					$cmd="$ifconfig $cint unplumb";
				} else {
					$cmd="$ifconfig $cint inet 0.0.0.0 ";
				}
				push @$results,"LOG Removing $cip: $cmd";
				$cmd.=" 2>&1";
				my $r=`$cmd`; chomp $r;
				if($?>>8 && length($r)) {
					next if $r =~ /Cannot assign requested/; # dodgy non-error
					return(0,"Unable to unassign IP address $cip from $cint - '$r'");
				}
			}
		}
	}
	return(1);
}

#########################################################################
# migrate_ips(oldcard=>card,card=>newcard)				#
# This will migrate all IPs from the current interface specified in	#
# "oldcard" to the card specified in "card".				#
# It will return (1) or (0,error,...).					#
# It captures all IP information associated with the old card, and then	#
# applies them the the new card once all the old IP stuff has been	#
# taken down.								#
#									#
# It also records all route information associated with the old card,	#
# and checks afterwards if any routes are missing and applies them to	#
# the new card.								#
#									#
#########################################################################

sub CLNET2_migrate_ips {
my %args=@_;
my ($oldcard,$card);

	local $SIG{CHLD}='IGNORE';
	if(!exists($args{oldcard}) || !exists($args{card})) {
		return(0,"Missing mandatory argument (requires oldcard,card)");
	}
	$card=$args{card};
	$oldcard=$args{oldcard};

	#################################################################
	# If any virtual component has been specified, then rip it	#
	# off right now...						#
	#################################################################
	$card =~ s/:\d+$//g;
	$oldcard =~ s/:\d+$//g;

	#################################################################
	# Get hold of the existing route information, based on the	#
	# oldcard information.						#
	# We also capture the netmask and broadcast information of the	#
	# base IP associated with the card we wish to migrate.		#
	#################################################################

	my $ipinters=new ipinterfaces();
	my $c_card=$ipinters->get_details(interface=>"$oldcard");
	if(!defined($c_card)) {
		return(0,"Unable to get details of existing card '$oldcard'.");
	}
	my @routes=$ipinters->get_routes(interface=>$oldcard);
	
	#################################################################
	# The first thing we do is to take down the real interface	#
	# which will drop all the virtual addresses too.		#
	#################################################################

	my $dcmd="";
	if($^O eq "solaris") {
		$dcmd="LD_PRELOAD= ifconfig $oldcard unplumb 2>&1; ifconfig $oldcard plumb 2>&1";
	} else {
		$dcmd="LD_PRELOAD= ifconfig $oldcard inet 0.0.0.0 2>&1";
	}
	my $acmd="LD_PRELOAD= ifconfig $card inet " . $c_card->{ip} . " ";
	$acmd.="netmask ".$c_card->{netmask}." " if(exists($c_card->{netmask}) && defined($c_card->{netmask}));
	$acmd.="broadcast ".$c_card->{broadcast}." " if(exists($c_card->{broadcast}) && defined($c_card->{broadcast}));
	$acmd.="up 2>&1; ";

	#################################################################
	# We generate a list of commands to run to add back necessary	#
	# IP addresses.							#
	#################################################################

	my @alist=();
	push @alist,$card;

	#################################################################
	# Now we add details back for all the virtual interfaces	#
	# that were on the previous card.				#
	#################################################################

	my ($ncard,$nn);
	my @l=$ipinters->list(logical=>1);
	for $cc (@l) {
		($ncard,$nn)=($cc =~ /^(.*):(.*)/);
		next if (!defined($nn) || !defined($ncard));
		next if $ncard ne $oldcard;

		#########################################################
		# Ignore details for other cards.			#
		#########################################################

		$c_card=$ipinters->get_details(interface=>$cc);
		next if !defined($c_card);
		$acmd.="LD_PRELOAD= ifconfig $card:$nn inet ".$c_card->{ip}." ";
		$acmd.="netmask ".$c_card->{netmask}." " if(exists($c_card->{netmask}) && defined($c_card->{netmask}));
		$acmd.="broadcast ".$c_card->{broadcast}." " if(exists($c_card->{broadcast}) && defined($c_card->{broadcast}));
		$acmd.="up 2>&1; ";
		push @alist,"$card:$nn";
	}

	#################################################################
	# Now "acmd" is a list of commands to set up the new IP		#
	# details, and dcmd is the command to take the old primary	#
	# interface down.						#
	#################################################################

	::msg("Removing existing IP details:");
	::msg($dcmd);
	::msg("Adding IP addresses back:");
	::msg($acmd);
	$r=`$dcmd`;
	chomp $r;
	if(length($r)) {
		::msg("Return code from removing existing IP addresses:\n$r");
	}
	$r=`$acmd`;
	chomp $r;
	if(length($r)) {
		::msg("Return code from adding IP addresses:\n$r");
	}

	#################################################################
	# Ok - IP's moved so we must attempt to send out an ARP		#
	# if available, either internally or externally.		#
	#################################################################

	if(defined(&miitoollib::send_arp)) {
		::msg("Sending grat arp request for all IP addresses.");
		miitoollib::send_arp($_) for (@alist);
	} elsif(-x "/sbin/cluster/tools/send_arp") {
		::msg("Sending grat arp request for all IP addresses.");
		`/sbin/cluster/tools/send_arp $_ 2>&1` for (@alist);
	}
	$ipinters->set_routes(interface=>$card,routes=>\@routes);
	return(1);
}

#################################################################
# This will return 0 if no physical link checking is 		#
# available, or 1 if it is.					#
# The 2nd value is the number of checks per-second maximum 	#
# that are recommended.						#
#################################################################

sub CLNET2_physical_link_checking {

	if($^O eq "freebsd") {
		# always use ifconfig, so 10 times
		return(1,10);
	}
	if($^O eq "hpux") {
		if($have_linkloop) {
			return(1,5);
		}
		return(0,0);	# linkloop not installed.
	}
	if($^O eq "aix") {
		if($have_entstat) {
			return(1,5);
		}
		return(0,0);	# entstat not installed/available
	}
	if($^O eq "solaris") {
		if($have_dladm) {
			return(1,5);
		}
		return(0,0);	# dladm not installed.
	}
	if($^O eq "linux") {
		if($have_miiquery+$have_ethtoolquery) {
			return(1,20);
		}
		if($have_ethtool_bin) {
			return(1,5);
		}
		return(0,0);	# No tools available for link checking
	}

	return(0,0);	# shouldn't get here, but just in case...
}

#################################################################
# The below sub will assume the link is OK if there is no way	#
# to actually monitor it.					#
# If on HP-UX will expect hw and ci to be specified as		#
# arguments [which nethardware module can provide].		#
#################################################################

sub CLNET2_checklink {
my %args=@_;

	if(!exists($args{card})) {
		return(2,"Missing mandatory argument 'card'.");
	}

	if($^O eq "freebsd") {
		my $z=ifconfig_status($args{card});
		if($z==-1) {
			return(2,"Unable to use ifconfig for '$args{card}'.");
		}
		return($z,undef);
	}
	if($^O eq "hpux") {
		if(!exists($args{hw}) || !exists($args{ci})) {
			return(2,"Missing mandatory arguments 'hw/ci'.");
		}
		return(1,undef) if ! $have_linkloop;
		my $cmd="$have_linkloop_bin -n 1 -i $args{ci} 0x$args{hw} 2>&1";
		my $r=`$cmd`;
		if($r =~ /did not receive data part of message/) {
			if(defined(&::warning)) {
				::warning("Link check failed!!! $cmd");
				::warning("Result: $r");
			}
			return(0,undef); # Link is down
		}
		return(1,undef);
	}
	#########################################################
	# For AIX we use entstat if available.			#
	#########################################################
	if($^O eq "aix") {
		return(1,undef) if ! $have_entstat;
		my $cmd="$have_entstat_bin -d $args{card} 2>/dev/null";
		my $r=`$cmd`;
		if($r =~ /Link Status : (.*)\n/) {
			if($1 eq "Up") {
				return(1,undef);
			}
			return(0,undef); # link is down
		}
		# not sure, so assume up!
		return(1,undef);
	}

	#########################################################
	# For Solaris we use dladm if available.		#
	#########################################################
	if($^O eq "solaris") {
		return(1,undef) if ! $have_dladm;
		my $cmd="$have_dladm_bin show-link $args{card} 2>/dev/null";
		my $r=`$cmd`; my @FFF=split(/\n/,$r);
		if(defined($FFF[1])) {
			my @FF2=split(/\s+/,$FFF[1]);
			if(defined($FF2[3])) {
				if($FF2[3] eq "down") {
					return(0,undef);
				} else {
					return(1,undef);
				}
			}
		}
		return(0,undef);
	}
	# Everything from this point is Linux.
	return(1,undef) if $have_miiquery+$have_ethtoolquery+$have_ethtool==0;
	if($have_ethtoolquery) {
		$r=miitoollib::ethtoolquery($args{card});
		if($r==1) {
			return(1,undef);
		}
		if($r==2) {
			return(1,undef); # not supported .. assume true
		}
	}
	if($have_miiquery) {
		my $r=miitoollib::miiquery($args{card});
		if($r =~ /link ok/) {
			return(1,undef);
		}
	}
	#################################################################
	# Add stuff for runnig ethool_bin is available.			#
	#################################################################
	return(0,undef); # Link is down
}

1;

